home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / acad / autolisp / chg / chg.lsp
Lisp/Scheme  |  1989-09-24  |  11KB  |  200 lines
  1. ;;; -*-  Mode: LISP -*- Syntax: AutoLISP (C) Benjamin Olasov 1988, 1989
  2. ;;; Displays and modifies the properties of individual entities.
  3.  
  4. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5. ;;; File: CHG.LSP Copyright (C) Benjamin Olasov    Graphic Systems, Inc.    ;;;
  6. ;;; Inquiries:                                                              ;;;
  7. ;;;                                                                         ;;;
  8. ;;;     Benjamin Olasov                                                     ;;;
  9. ;;;     Graphic Systems, Inc.:                                              ;;;
  10. ;;;                                                                         ;;;
  11. ;;;                    New York, NY:   PH (212) 725-4617                    ;;;
  12. ;;;                    Cambridge, MA:  PH (617) 492-1148                    ;;;
  13. ;;;                    MCI-Mail:       GSI-NY   344-4003                    ;;;
  14. ;;;                    Arpanet:        olasov@cs.columbia.edu               ;;;
  15. ;;;                                                                         ;;;
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17.  
  18. ;; This program is provided 'as is' without warranty of any kind, either 
  19. ;; expressed or implied, including, but not limited to the implied warranties of
  20. ;; merchantability and fitness for a particular purpose.  The entire risk as to
  21. ;; the quality and performance of the program is with the user.  Should the 
  22. ;; program prove defective, the user assumes the entire cost of all necessary 
  23. ;; servicing, repair or correction. 
  24. ;; AutoLisp and AutoCad are registered trademarks of AutoDesk, Inc.
  25.  
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  27. ;; CHG displays and modifies the properties of individual entities.          ;;
  28. ;;                                                                           ;;
  29. ;; CHG creates a numbered menu of the selected entities properties, and      ;;
  30. ;; then prompts the user to select the number of the property to modify.     ;;
  31. ;; CHG then prompts for a new value for that property, which may be a        ;;
  32. ;; point (list), real, integer, or string.                                   ;;
  33. ;;                                                                           ;;
  34. ;; Any changes made by CHG can be undone using AutoCad's 'U' command.        ;;
  35. ;; Doing so will return the drawing to its state before using CHG.           ;;
  36. ;;                                                                           ;;
  37. ;; An example use of CHG:                                                    ;;
  38. ;; In a drawing containing two valid blocks A and B, an individual           ;;
  39. ;; iteration of block A can be transformed to an iteration of block B by     ;;
  40. ;; giving B as its new name. All of its previous insertion parameters will   ;;
  41. ;; remain the same, but its identity will be changed to block B. If the      ;;
  42. ;; name of the layer in which the entity resides is changed to the name of   ;;
  43. ;; an existing layer, the entity will change its residence to that layer.    ;;
  44. ;; However, if the new layer name is the name of a non-existing layer, a     ;;
  45. ;; layer with that name will be created, and the entity will be transferred  ;;
  46. ;; to that layer.                                                            ;;
  47. ;;                                                                           ;;
  48. ;; Syntax: CHG                                                               ;;
  49. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  50.  
  51. (gc)
  52. (vmon)
  53. (princ "\nLoading- please wait.")
  54.  
  55. (defun descriptor (key)
  56.        (cond ((null key) nil)
  57.              ((= key 0) "ENTITY TYPE: ")
  58.              ((= key 1) "TEXT VALUE: ")
  59.              ((and (= key 2)
  60.                    (= (cdr (assoc 0 entity)) "ATTDEF")) "ATTRIBUTE TAG: ")
  61.              ((and (= key 2)
  62.                   (= (cdr (assoc 0 entity)) "INSERT")) "BLOCK NAME: ")
  63.              ((= key 2) "NAME: ")
  64.              ((or (= key 3)
  65.                   (= key 4)) "OTHER NAME VALUES: ")
  66.              ((= key 5) "HANDLE <RO>: ")
  67.              ((= key 6) "LINETYPE NAME <RO>: ")
  68.              ((= key 7) "TEXT STYLE NAME <RO>: ")
  69.              ((= key 8) "LAYER: ")
  70.              ((= key 9) "VARIABLE NAME IDENTIFIER: ")
  71.              ((and (= key 10)
  72.                    (= (cdr (assoc 0 entity)) "INSERT")) "INSERTION BASE: ")
  73.              ((= key 10) "ORIGIN POINT: ")
  74.              ((and (>= key 11)
  75.                    (<= key 18)) "OTHER POINT COORDINATE: ")
  76.              ((= key 20) "PRIMARY Y COORDINATE: ")
  77.              ((and (>= key 21) (<= key 28)) "OTHER Y COORDINATE: ")
  78.              ((and (>= key 31) (<= key 36)) "OTHER Z COORDINATE: ")
  79.              ((= key 38) "ELEVATION: ")
  80.              ((= key 39) "THICKNESS: ")
  81.              ((and (>= key 40)
  82.                    (<= key 48)
  83.                    (or (= (CDR (ASSOC 0 ENTITY)) "CIRCLE")
  84.                        (= (CDR (ASSOC 0 ENTITY)) "ARC"))) "RADIUS: ")
  85.              ((and (>= key 40)
  86.                     (<= key 48)
  87.                    (or (= (cdr (assoc 0 entity)) "TEXT")
  88.                        (= (cdr (assoc 0 entity)) "ATTDEF"))) "TEXT HEIGHT: ")
  89.              ((and (= key 41)
  90.                    (= (cdr (assoc 0 entity)) "INSERT")) "X SCALE FACTOR: ")
  91.              ((and (= key 42)
  92.                    (= (cdr (assoc 0 entity)) "INSERT")) "Y SCALE FACTOR: ")
  93.              ((and (= key 43)
  94.                    (= (cdr (assoc 0 entity)) "INSERT")) "Z SCALE FACTOR: ")
  95.              ((and (>= key 40)
  96.                     (<= key 48)) "FLOATING POINT VALUE: ")
  97.              ((= key 49) "REPEATED VALUE: ")
  98.              ((and (>= key 50)
  99.                    (<= key 58)) "ANGLE: ")
  100.              ((= key 62) "COLOR NUMBER <RO>: ")
  101.              ((= key 66) "ENTITIES FOLLOW <RO>: ")
  102.              ((= key 71) "MIRROR DIRECTION: ")
  103.              ((and (>= key 70) (<= key 78)) "INTEGER VALUE: ")
  104.              ((or (= key 210)
  105.                   (= key 220)
  106.                   (= key 230)) "EXTRUSION DIRECTION COORDINATES: ")
  107.              ((= key 999) "COMMENTS: ")
  108.              (T "UNCLASSIFIED VALUE: ")))
  109.  
  110. (princ ".")
  111.  
  112. (defun format-input (key / val label)
  113.        (if (null key) nil
  114.            (progn (setq val (cdr (assoc key entity)))
  115.                   (cond ((= (type val) 'STR)
  116.                          (graphscr)
  117.                          (setq label (descriptor key))
  118.                          (princ (strcat "\nCurrent " label))
  119.                          (princ val)
  120.                          (getstring T (strcat "\nNew " label)))
  121.                         ((= (type val) 'REAL)
  122.                          (cond ((and (>= key 40)
  123.                                      (<= key 48)
  124.                                 (or (= (cdr (assoc 0 entity)) "CIRCLE")
  125.                                     (= (cdr (assoc 0 entity)) "ARC")))
  126.                                 (setvar "coords" 2)
  127.                                 (graphscr)
  128.                                 (princ "\nCurrent angle: ")
  129.                                 (princ val)
  130.                                 (getdist (cdr (assoc 10 entity)) "\nNew radius: "))
  131.                                ((and (>= key 50) (<= key 58))
  132.                                 (setvar "coords" 2)
  133.                                 (graphscr)
  134.                                 (princ "\nCurrent angle: ")
  135.                                 (princ val)
  136.                                 (getangle (cdr (assoc 10 entity)) "\nNew angle: "))
  137.                               (T (graphscr)
  138.                                  (setq label (descriptor key))
  139.                                  (princ (strcat "\nCurrent " label))
  140.                                  (princ val)
  141.                                  (getreal (strcat "\nNew " label)))))
  142.                          ((= (type val)  'INT)
  143.                           (setq label (descriptor key))
  144.                           (princ (strcat "\nCurrent " label))
  145.                           (princ val)
  146.                           (getint (strcat "\nNew " label)))
  147.                          ((= (type val) 'LIST)
  148.                           (graphscr)
  149.                           (setvar "coords" 2)
  150.                           (princ "\nCurrent point value: ")
  151.                           (princ val)
  152.                           (getpoint val "\nNew point: "))))))
  153.  
  154. (princ ".")
  155.  
  156. (defun C:CHG (/ entity counter ctr num tag new)
  157.        (if (setq ename (entsel))
  158.            (progn (setq entity (cdr (setq ent (entget (car ename))))
  159.                         header (strcat (cdr (assoc 0 entity)) " PROPERTY TABLE")
  160.                         num_props (length (cdr entity))
  161.                         counter 0
  162.                         ctr 0)
  163.                   (textscr)
  164.                   (repeat 24 (terpri))
  165.                   (repeat (- 38 (/ (strlen header) 2)) (princ "\260"))
  166.                   (princ (strcat " " header " "))
  167.                   (repeat (- 38 (/ (strlen header) 2)) (princ "\260"))
  168.                   (repeat (fix (/ (- 24 num_props) 2.0)) (terpri))
  169.                   (mapcar '(lambda (e)
  170.                                    (setq counter (1+ counter))
  171.                                    (princ (strcat (if (< counter 10)
  172.                                                       (strcat " " (itoa counter)) 
  173.                                                       (itoa counter))
  174.                                                   "]  "
  175.                                                   (descriptor (car e))))
  176.                                    (princ (cdr e))
  177.                                    (princ "\n"))
  178.                           (cdr entity))
  179.                   (repeat (fix (/ (- 24 num_props) 2.0)) (terpri))
  180.                   (setq num (getint "Number of property to change: "))
  181.                   (if (and num
  182.                            (> num 0)
  183.                            (<= num num_props))
  184.                       (progn (setq tag (car (nth (1- num) (cdr entity)))
  185.                                    new (format-input tag)
  186.                                    ent (subst (cons tag new)
  187.                                               (assoc tag entity) ent)
  188.                                    cmd (getvar "cmdecho"))
  189.                              (setvar "cmdecho" 0)
  190.                              (command "undo" "mark")
  191.                              (setvar "cmdecho" cmd)
  192.                              (entmod ent))
  193.                       (princ "\nInvalid number.")))
  194.            (princ "\nNo entity selected."))
  195.        (princ))
  196.  
  197. (princ "\nFunction C:CHG loaded. Type CHG to start.")
  198. (princ)
  199.  
  200.